home *** CD-ROM | disk | FTP | other *** search
/ ftp.mactech.com 2010 / ftp.mactech.com.tar / ftp.mactech.com / online / source / c / compilers / Bob 1.5.sit.hqx / Bob 1.5 / Bobfcn.c < prev    next >
Text File  |  1991-10-12  |  6KB  |  291 lines
  1. /* bobfcn.c - built-in classes and functions */
  2. /*
  3.     Copyright (c) 1991, by David Michael Betz
  4.     All rights reserved
  5. */
  6.  
  7. #include "bob.h"
  8.  
  9. /* argument check macros */
  10. #define argcount(n,cnt)    { if ((n) != (cnt)) wrongcnt(n,cnt); }
  11.  
  12. /* stdio dispatch table */
  13. IODISPATCH fileio = {
  14.     fclose,
  15.     fgetc,
  16.     fputc,
  17.     fputs
  18. };
  19.  
  20. /* external variables */
  21. extern VALUE symbols;
  22.  
  23. /* forward declarations */
  24. #ifdef __STDC__
  25. static int xtypeof(int argc);
  26. static int xgc(int argc);
  27. static int xnewvector(int argc);
  28. static int xnewstring(int argc);
  29. static int xsizeof(int argc);
  30. static int xfopen(int argc);
  31. static int xfclose(int argc);
  32. static int xgetc(int argc);
  33. static int xputc(int argc);
  34. static int xprint(int argc);
  35. static int xgetarg(int argc);
  36. static int xsystem(int argc);
  37. #else
  38. int xtypeof(),xgc();
  39. int xnewvector(),xnewstring(),xsizeof(),xprint(),xgetarg(),xsystem();
  40. int xfopen(),xfclose(),xgetc(),xputc();
  41. #endif
  42.  
  43. /* init_functions - initialize the internal functions */
  44. void init_functions()
  45. {
  46.     add_function("typeof",xtypeof);
  47.     add_function("gc",xgc);
  48.     add_function("newvector",xnewvector);
  49.     add_function("newstring",xnewstring);
  50.     add_function("sizeof",xsizeof);
  51.     add_function("fopen",xfopen);
  52.     add_function("fclose",xfclose);
  53.     add_function("getc",xgetc);
  54.     add_function("putc",xputc);
  55.     add_function("print",xprint);
  56.     add_function("getarg",xgetarg);
  57.     add_function("system",xsystem);
  58. }
  59.  
  60. /* add_function - add a built-in function */
  61. void add_function(name,fcn)
  62.   char *name; int (*fcn)();
  63. {
  64.     DICT_ENTRY *sym;
  65.     sym = addentry(&symbols,name,ST_SFUNCTION);
  66.     set_code(&sym->de_value,fcn);
  67. }
  68.  
  69. /* xtypeof - get the data type of a value */
  70. static int xtypeof(argc)
  71.   int argc;
  72. {
  73.     argcount(argc,1);
  74.     set_integer(&sp[1],sp->v_type);
  75.     ++sp;
  76. }
  77.  
  78. /* xgc - invoke the garbage collector */
  79. static int xgc(argc)
  80.   int argc;
  81. {
  82.     argcount(argc,0);
  83.     gc();
  84.     set_nil(sp);
  85. }
  86.  
  87. /* xnewvector - allocate a new vector */
  88. static int xnewvector(argc)
  89.   int argc;
  90. {
  91.     int size;
  92.     argcount(argc,1);
  93.     chktype(0,DT_INTEGER);
  94.     size = sp->v.v_integer;
  95.     set_vector(&sp[1],newvector(size));
  96.     ++sp;
  97. }
  98.  
  99. /* xnewstring - allocate a new string */
  100. static int xnewstring(argc)
  101.   int argc;
  102. {
  103.     int size;
  104.     argcount(argc,1);
  105.     chktype(0,DT_INTEGER);
  106.     size = sp->v.v_integer;
  107.     set_string(&sp[1],newstring(size));
  108.     ++sp;
  109. }
  110.  
  111. /* xsizeof - get the size of a vector or string */
  112. static int xsizeof(argc)
  113.   int argc;
  114. {
  115.     argcount(argc,1);
  116.     switch (sp->v_type) {
  117.     case DT_VECTOR:
  118.     set_integer(&sp[1],sp->v.v_vector->vec_size);
  119.     break;
  120.     case DT_STRING:
  121.     set_integer(&sp[1],sp->v.v_string->str_size);
  122.     break;
  123.     default:
  124.     break;
  125.     }
  126.     ++sp;
  127. }
  128.  
  129. /* xfopen - open a file */
  130. static int xfopen(argc)
  131.   int argc;
  132. {
  133.     char name[50],mode[10];
  134.     FILE *fp;
  135.     argcount(argc,2);
  136.     chktype(0,DT_STRING);
  137.     chktype(1,DT_STRING);
  138.     getcstring(name,sizeof(name),&sp[1]);
  139.     getcstring(mode,sizeof(mode),&sp[0]);
  140.     if ((fp = fopen(name,mode)) == NULL)
  141.     set_nil(&sp[2]);
  142.     else
  143.     set_iostream(&sp[2],newiostream(&fileio,fp));
  144.     sp += 2;
  145. }
  146.  
  147. /* xfclose - close a file */
  148. static int xfclose(argc)
  149.   int argc;
  150. {
  151.     argcount(argc,1);
  152.     chktype(0,DT_IOSTREAM);
  153.     set_integer(&sp[1],iosclose(&sp[0]));
  154.     ++sp;
  155. }
  156.  
  157. /* xgetc - get a character from a file */
  158. static int xgetc(argc)
  159.   int argc;
  160. {
  161.     argcount(argc,1);
  162.     chktype(0,DT_IOSTREAM);
  163.     set_integer(&sp[1],iosgetc(&sp[0]));
  164.     ++sp;
  165. }
  166.  
  167. /* xputc - output a character to a file */
  168. static int xputc(argc)
  169.   int argc;
  170. {
  171.     argcount(argc,2);
  172.     chktype(0,DT_IOSTREAM);
  173.     chktype(1,DT_INTEGER);
  174.     set_integer(&sp[2],iosputc((int)sp[1].v.v_integer,&sp[0]));
  175.     sp += 2;
  176. }
  177.  
  178. /* xprint - generic print function */
  179. static int xprint(argc)
  180.   int argc;
  181. {
  182.     extern VALUE stdout_iostream;
  183.     int n;
  184.     for (n = argc; --n >= 0; )
  185.     print1(&stdout_iostream,FALSE,&sp[n]);
  186.     sp += argc;
  187.     set_nil(sp);
  188. }
  189.  
  190. /* print1 - print one value */
  191. print1(ios,qflag,val)
  192.   VALUE *ios; int qflag; VALUE *val;
  193. {
  194.     char name[TKNSIZE+1],buf[200],*p;
  195.     VALUE *class;
  196.     int len;
  197.     switch (val->v_type) {
  198.     case DT_NIL:
  199.     iosputs("nil",ios);
  200.     break;
  201.     case DT_CLASS:
  202.     getcstring(name,sizeof(name),clgetname(val));
  203.     sprintf(buf,"#<Class-%s>",name);
  204.     iosputs(buf,ios);
  205.     break;
  206.     case DT_OBJECT:
  207.     sprintf(buf,"#<Object-%lx>",objaddr(val));
  208.     iosputs(buf,ios);
  209.     break;
  210.     case DT_VECTOR:
  211.     sprintf(buf,"#<Vector-%lx>",vecaddr(val));
  212.     iosputs(buf,ios);
  213.     break;
  214.     case DT_INTEGER:
  215.     sprintf(buf,"%ld",val->v.v_integer);
  216.     iosputs(buf,ios);
  217.     break;
  218.     case DT_STRING:
  219.     if (qflag) iosputc('"',ios);
  220.     p = strgetdata(val);
  221.     len = strgetsize(val);
  222.     while (--len >= 0)
  223.         iosputc(*p++,ios);
  224.     if (qflag) iosputc('"',ios);
  225.     break;
  226.     case DT_BYTECODE:
  227.     sprintf(buf,"#<Bytecode-%lx>",vecaddr(val));
  228.     iosputs(buf,ios);
  229.     break;
  230.     case DT_CODE:
  231.     sprintf(buf,"#<Code-%lx>",val->v.v_code);
  232.     iosputs(buf,ios);
  233.     break;
  234.     case DT_VAR:
  235.     class = digetclass(degetdictionary(val));
  236.     if (!isnil(class)) {
  237.         getcstring(name,sizeof(name),clgetname(class));
  238.         sprintf(buf,"%s::",name);
  239.         iosputs(buf,ios);
  240.     }
  241.     getcstring(name,sizeof(name),degetkey(val));
  242.     iosputs(name,ios);
  243.     break;
  244.     case DT_IOSTREAM:
  245.     sprintf(buf,"#<Stream-%lx>",val->v.v_iostream);
  246.     iosputs(buf,ios);
  247.     break;
  248.     default:
  249.     error("Undefined type: %d",valtype(val));
  250.     }
  251. }
  252.  
  253. /* xgetarg - get an argument from the argument list */
  254. static int xgetarg(argc)
  255.   int argc;
  256. {
  257.     extern char **bobargv;
  258.     extern int bobargc;
  259.     int i;
  260.     argcount(argc,1);
  261.     chktype(0,DT_INTEGER);
  262.     i = sp[0].v.v_integer;
  263.     if (i >= 0 && i < bobargc)
  264.     set_string(&sp[1],makestring(bobargv[i]));
  265.     else
  266.     set_nil(&sp[1]);
  267.     ++sp;
  268. }
  269.  
  270. /* xsystem - execute a system command */
  271. static int xsystem(argc)
  272.   int argc;
  273. {
  274.     char cmd[133];
  275.     argcount(argc,1);
  276.     chktype(0,DT_STRING);
  277.     getcstring(cmd,sizeof(cmd),&sp[0]);
  278.     set_integer(&sp[1],system(cmd));
  279.     ++sp;
  280. }
  281.  
  282. /* wrongcnt - report wrong number of arguments */
  283. void wrongcnt(n,cnt)
  284.   int n,cnt;
  285. {
  286.     if (n < cnt)
  287.     error("Too many arguments");
  288.     else if (n > cnt)
  289.     error("Too few arguments");
  290. }
  291.